Attribute VB_Name = "modODBCStaticControl"
'---------------------------------------------------------------------------------------
'Module     : modODBC
'Date       : 05/18/2004
'Updated    : 02/21/2005
'Author     : Chris Elwell
'Purpose    : This is an example of a CIC integration module. This is for demostration
'           purposes only. You must write the code required to get/writeback data from/to
'           your customer's data source.
'
'           This example uses the FSMSClientTest.mdb. A DSN is setup as FSMSClientTest.
'           Regardless of the integration method, CICs must have a module that contains
'           specific sub routines. All of these subs/functions listed below must exist
'           as they are called from the main program.
'           Public Function GetData(ByVal strKey As String) As Boolean - this routine is
'               called when the Order ID field loses focus. This is where you would code to
'               get order data from a customer and populate the screen fields. You can create
'               and call as many support routines as necessary. Also, this routine should
'               return a boolean True if getting the order data was succesful and a boolean
'               False if it was not.
'           Public Sub WriteReply() - this is called after a successful shipment. A typical
'               use would be to write FXRS reply data back to a customer's system, but can be
'               used for anything that you want to have happen after a pckage is shipped.
'           Public Sub WriteError() - this is called after an error is returned from FXRS.
'           Public Sub WriteDelete(ByVal strTracking As String) - this is called after a
'               package is successfully deleted.
'           Public Sub AfterClose() - this is called after FXRS is closed.
'           Public Sub BeforeClose() - this is called just before an FXRS close transaction
'               is sent.
'Updated:   Public Function BeforeShip() - Return TRUE to continue shipment, False to cancel.
'           Public Sub Initialize() - this is called once on program execution.
'           Public Sub BeforeBatch() - this is called before processing a batch file.
'           Public Sub BeforeBatchShip() - this is called before each individual batch transaction.
'New:       Public Sub AfterAddrLookup() - this is called after cboCustID, cboContact, and cboCompany lose focus
'New:       Public Sub AfterDeptLostFocus() - this is called after cboDept or f38 loses focus.
'
' 2005-04-20, JFW, Added AddDSN for integration database.
' 2006-11-07, JFW, Add order to MPS select to preserve package order
' 2007-07-31, JFW, Per Rick Dingman, warn shipper of previous shipment on this order.
' 2007-07-31, JFW, Per Rick Dingman, change use of address lines.
' 2007-10-23, JFW, Per Rick, no email on service orders.
'
'---------------------------------------------------------------------------------------


' See Project properties for Conditional Compilation
#If StaticControl Then

Option Explicit

Private Const CUSTOMER_DSN As String = "DSN=AS400"
Private Const CUSTOMER_USN As String = "SHIPPER"
Private Const CUSTOMER_PWD As String = "SHIPPER"
Private Const CUSTOMER_DEFAULT_PHONE As String = ""

Private Const CUSTOMER1_DSN As String = "DSN=TRACKING"
Private Const CUSTOMER1_USN As String = "trackinguser"
Private Const CUSTOMER1_PWD As String = "tuser"

Public g_strKeyValue As String

Dim m_CNIn As ADODB.Connection
Dim m_CNOut As ADODB.Connection
Dim m_CNCommit As ADODB.Connection
Dim m_RS As ADODB.Recordset
Dim intRecordCurrent As Long
Dim m_strLine As String
Dim m_boolShipComplete As Boolean
Dim m_boolShipDateChanged As Boolean

Dim m_booleanOnce As Boolean

'2/8/05 - API function declaration to add DSN to system used in AddDSN() function.
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal _
   hwndParent As Long, ByVal fRequest As Long, ByVal _
   lpszDriver As String, ByVal lpszAttributes As String) As Long

'+
' 2006-09-20, JFW, From Copernicus FXI
' Declare object(s)
Public g_strCustNo As String        'Hold Customer Number
'Public g_strPONo As String          'Hold Customer PO Number
Public g_strRefNo As String         'Hold Customer Reference Number
Public g_strCountry As String       'Hold shipto Country
Public g_strZip As String           'Holds zip code
Public g_strEmail As String         'Hold Email address
Public g_strEmail2 As String        'Hold Email address
Public g_blnServiceOrder As Boolean 'Flage for email
' 2011-05-06, JFW, Carry this from import to export.
Dim m_strInvoiceSDN As String
' 2012-09-06, JFW, New GB Micro SAP, import shipper name, use this to save default.
Dim m_strShipperCompany As String
'~

   
'---------------------------------------------------------------------------------------
' Procedure : AddDSN
' DateTime  : 2/8/2005
' Purpose   : Adds the FSMSClient v720.3 DSN
' Call from : Form_Load
'---------------------------------------------------------------------------------------
'
Private Function AddDSN() As Boolean
    On Error GoTo EH
    
    Dim ret As Long
    Dim Driver As String
    Dim Attributes As String
    
'    If GetSystemName = "WINXPC9CA96EA3" _
'    Or GetSystemName = "CAN00335113" Then
'        Driver = "Microsoft Access Driver (*.mdb)"
'        Attributes = Attributes & "DBQ=C:\Program Files\FedEx\Integration\Projects\Copernicus\Data\Orders.mdb" & Chr(0)
'    Else
'        Driver = "Microsoft Access Driver (*.mdb)"
'        Attributes = Attributes & "DBQ=" & App.Path & "\FSMSClientTest.mdb" & Chr(0)
'    End If
'    Attributes = Attributes & "DSN=CopernicusFSMS" & Chr(0)
'    Attributes = Attributes & "DESCRIPTION=FSMS Client Copernicus ship data" & Chr(0)
'
'    ret = SQLConfigDataSource(0, 4, Driver, Attributes)
   
    If ret <> 1 Then
        AddDSN = False
    Else
        AddDSN = True
    End If

    Exit Function
EH:
    AddDSN = False

End Function
'


'---------------------------------------------------------------------------------------
' Procedure : AfterAddrLookup()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboCustID, cboContact, or cboCompany loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrLookup()

End Sub
'



' Procedure : AfterAddrVerify()
' DateTime  : 5/12/2006
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             Address Verification. Three possible status codes are passed. See comments
'             below.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrVerify(ByVal intStatusCode As Integer)

    Select Case intStatusCode
        'Address is verfified
        Case 1

        'Soft error
        Case 2

        'Hard error
        Case 3

    End Select

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterAddrVerifyUpdate()
' DateTime  : 9/13/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             an address has been updated on the Ship form.
'---------------------------------------------------------------------------------------
'
Public Sub AfterAddrVerifyUpdate()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterBatchShip()
' DateTime  : 10/28/2005
' Purpose   : REQUIRED SUB. Called just after a batch transaction has been processed.
'---------------------------------------------------------------------------------------
'
Public Sub AfterBatchShip()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterBatch()
' DateTime  : 4/6/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             a batch shipment has been completed.
'---------------------------------------------------------------------------------------
'
Public Sub AfterBatch()

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterClose()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             FXRS Close.
'---------------------------------------------------------------------------------------
'
Public Sub AfterClose()

End Sub
'


' 2007-04-13, JFW, Allow for custom screen display.
Public Sub AfterConnect()

    ' For Manulife, go to customer lookup
    ' Call frmShip.ToggleLookup(True)

End Sub
'

' 2011-02-01, JFW, Clear DG disclaimer automatically.
Public Function AfterDGDisclaimer() As Boolean
    AfterDGDisclaimer = True
End Function
'

' 2007-04-13, JFW, Allow for custom screen display.
Public Sub AfterDisconnect()

    On Error Resume Next
    
End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterLoadServices()
' DateTime  : 5/17/2011
' Purpose   : Remove or add custom services.
' 2011-05-17, JFW, New for Scapa
'---------------------------------------------------------------------------------------
'
Public Sub AfterLoadServices(c1 As ComboBox)

End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : AfterDeptLostFocus()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             cboDept or f38 loses focus.
'---------------------------------------------------------------------------------------
'
Public Sub AfterLostFocus(c1 As Control)

'    If c1.name = "f38" Then
'        g_clsReg.SetRegistryValue "Carry_f38", frmShip.f38, REG_SZ
'    End If
'    If c1.name = "f1273" Then
'        g_clsReg.SetRegistryValue "Carry_f1273", Left(frmShip.f1273.Text, 2), REG_SZ
'    End If
    
End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterLocationChange()
' DateTime  : 3/06/2006
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             the shipping Location has been changed on the Ship form.
'---------------------------------------------------------------------------------------
'
Public Sub AfterLocationChange()
'    debugprint "AfterLocationChange, company now " & g_str4
'    m_strShipperCompany = g_str4
End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : AfterRateQuote()
' DateTime  : 20071106-01
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             a rate quote.
'---------------------------------------------------------------------------------------
'
Public Sub AfterRateQuote()

End Sub
'

' 2012-01-19, JFW, New for UCS.
Public Function AfterScreenChange(f As Form) As Boolean

End Function

' 2011-05-05, JFW, For Scapa
Public Function TDAutoCloseEnabled() As Boolean
    TDAutoCloseEnabled = False
End Function
'


'---------------------------------------------------------------------------------------
' Procedure : BeforeBatch()
' DateTime  : 20070621-01 Changed BeforeBatch to return a boolean
' Purpose   : REQUIRED SUB. Called before an entire batch is processed.
'---------------------------------------------------------------------------------------
'
Public Function BeforeBatch() As Boolean

    BeforeBatch = True

End Function
'


'---------------------------------------------------------------------------------------
' Procedure : BeforeClose()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed before
'             FXRS Close.
'---------------------------------------------------------------------------------------
'
Public Function BeforeClose() As Boolean

    BeforeClose = True
    
End Function
'

' 2012-01-19, JFW, New for UCS.
Public Function BeforeGotFocus(f As Form, c As Control) As Boolean
'    On Error GoTo Test
'    Exit Function
'Test:
'    DebugPrint Now & " BeforeGotFocus " & Err.Description
'
End Function
'

'---------------------------------------------------------------------------------------
' Procedure : BeforeShip()
' DateTime  : 2/21/2005
' Purpose   : REQUIRED Function. Modified to Return Boolean which controls whether or not
'             the shipment will continue or be canceled. Return True to continue shipment,
'             False to cancel.
'---------------------------------------------------------------------------------------
'
Public Function BeforeShip() As Boolean
        
    Dim rsPreassign As New ADODB.Recordset
    Dim strQuery As String
    Dim strPreAssignKey As String
    
    BeforeShip = True
    
    ' Global variables are referenced here
'    If g_str1 <> "" Then
'    ElseIf frmShip.f1.Text <> "" Then
'        g_str1 = frmShip.f1.Text
'    ElseIf frmShip.cboCustID.Text <> "" Then
'        g_str1 = frmShip.cboCustID.Text
'    End If
'    If g_str1 = "" Then
'        MsgBox "Order ID or Customer ID is a required field.", vbApplicationModal + vbSystemModal
'        BeforeShip = False
'        Exit Function
'    End If
'    If g_str116 = "" Then
'        If IsNumeric(frmShip.f116.Text) Then
'            g_str116 = frmShip.f116.Text
'        Else
'            g_str116 = 1
'        End If
'    End If
'    If g_str1274 = "" Then
'        g_str1274 = Left(frmShip.f1274.Text, 2)
'    End If
    
End Function
'


'---------------------------------------------------------------------------------------
' Procedure : BeforeShipTrans()
' DateTime  : 8/7/2008
' Purpose   : REQUIRED Function. Modified to Return Boolean which controls whether or not
'             the shipment will continue or be canceled. Return True to continue shipment,
'             False to cancel.
'---------------------------------------------------------------------------------------
'
Public Function BeforeShipTrans(ByRef TransString As String) As Boolean
    
    Dim lngMsgBoxResult As VbMsgBoxResult
    BeforeShipTrans = True
    
End Function
'


'---------------------------------------------------------------------------------------
' Procedure : BuildCustomSPLabel()
' DateTime  : 20070620-04
' Purpose   : REQUIRED SUB. Can be used as hook to create custom EPL or ZPL buffer labels
'             for SmartPost.
'---------------------------------------------------------------------------------------
'
Public Function BuildCustomSPLabel(ByVal strLabel As String) As String

    BuildCustomSPLabel = strLabel

End Function
'

Public Function ClearCommodity() As Boolean

End Function
'

Public Function ClearShipScreen() As Boolean

    On Error Resume Next
    
'    frmShip.f38 = g_clsReg.GetRegistryValue("Carry_f38", "")
'    frmShip.f1273.Text = g_clsReg.GetRegistryValue("Carry_f1273", "")
'
'    If m_boolShipDateChanged Then
'        frmShip.f24.Text = Date
'        m_boolShipDateChanged = False
'    End If
'
'    g_strRefNo = ""
'    m_strInvoiceSDN = ""
'
'    g_str4 = m_strShipperCompany
'    debugprint "ClearShipScreen, company now " & g_str4
    
End Function


'---------------------------------------------------------------------------------------
' Procedure : Connect()
' DateTime  : 7/5/2004
' Purpose   : Open connection to ODBC test DSN. Instantiate module level recordset.
'---------------------------------------------------------------------------------------
'
Public Function Connect() As Boolean
    On Local Error GoTo Handler
    Dim strDSN As String
    Dim boolSecondTry As Boolean
    
    If m_CNIn Is Nothing Then
        Set m_CNIn = New ADODB.Connection
    End If
    
    If m_CNIn.State <> adStateOpen Then   'if connection is not open then do so
        If GetSystemName = "WINXPC9CA96EA3" _
        Or GetSystemName = "CAN00335113" _
        Or GetSystemName = "WIN7FSMSCLIENT" Then
            m_CNIn.Open "Driver={Microsoft Access Driver (*.mdb)};Dbq=C:\Projects\FSMSClient\Database\FSMSClient.mdb;Uid=Admin;Pwd=;"
            ' m_CNIn.Open "DSN=FSMSClient800CA4;DBQ=C:\Documents and Settings\Administrator\My Documents\StaticControl\uV_FCSDK_Fedex.mdb"
        Else
            m_CNIn.Open CUSTOMER_DSN & ";UID=" & CUSTOMER_USN & ";PWD=" & CUSTOMER_PWD
        End If
    End If
    
    If m_CNOut Is Nothing Then
        Set m_CNOut = New ADODB.Connection
    End If
    If m_CNOut.State <> adStateOpen Then   'if connection is not open then do so
        If GetSystemName = "WINXPC9CA96EA3" _
        Or GetSystemName = "CAN00335113" _
        Or GetSystemName = "WIN7FSMSCLIENT" Then
            m_CNOut.Open "Driver={Microsoft Access Driver (*.mdb)};Dbq=C:\Projects\FSMSClient\Database\FSMSClient.mdb;Uid=Admin;Pwd=;"
            ' Set m_CNOut = g_connFSMSClient
        Else
            m_CNOut.Open CUSTOMER1_DSN & ";UID=" & CUSTOMER1_USN & ";PWD=" & CUSTOMER1_PWD
        End If
    End If
    
'    If m_CNCommit Is Nothing Then
'        Set m_CNCommit = New ADODB.Connection
'    End If
'    If m_CNCommit.State <> adStateOpen Then   'if connection is not open then do so
'        If GetSystemName = "WINXPC9CA96EA3" _
'        Or GetSystemName = "CAN00335113" _
'        Or GetSystemName = "WIN7FSMSCLIENT" Then
'            m_CNCommit.Open "DSN=FSMSClient800CA4;DBQ=Z:\563774\Documents\FXI\Projects\Jose\uV_FCSDK_Fedex.mdb"
'        Else
'            m_CNCommit.Open "DSN=SAPbus1;UID=fedex;PWD=Fedex!"
'        End If
'    End If
    
    Set m_RS = New ADODB.Recordset
    
    Connect = True
    
    Exit Function

Handler:
    If Not boolSecondTry Then
        boolSecondTry = True
        If Err.number = -2147467259 Then
            Call AddDSN
            Resume
        End If
    End If
    MsgBox Err.Description, , "modODBC.Connect"
    Call Kill        'kill connection and recordset

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : Kill()
' DateTime  : 7/5/2004
' Purpose   : Close connection and recordset objects and set = to nothing.
'---------------------------------------------------------------------------------------
'
Public Sub Kill()
    On Local Error GoTo Handler
    
    If Not m_RS Is Nothing Then
        If m_RS.State = adStateOpen Then m_RS.Close
    End If
    Set m_RS = Nothing      'kill recordset
    
    If Not m_CNIn Is Nothing Then
        If m_CNIn.State = adStateOpen Then m_CNIn.Close
    End If
    Set m_CNIn = Nothing      'kill connection
    
    If Not m_CNOut Is Nothing Then
        If m_CNOut.State = adStateOpen Then m_CNOut.Close
    End If
    Set m_CNOut = Nothing      'kill connection
    
    If Not m_CNCommit Is Nothing Then
        If m_CNCommit.State = adStateOpen Then m_CNCommit.Close
    End If
    Set m_CNCommit = Nothing      'kill connection
    
    Exit Sub
Handler:
    MsgBox Err.Description, , "modODBC.Kill"

End Sub
'



'---------------------------------------------------------------------------------------
' Procedure : GetData()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Called from frmShip.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Function GetData(ByVal strKey As String) As Boolean
    On Local Error GoTo Handler
    Dim strSQL As String
    Dim strUserPwd As String    'DSN user and password separated by ','
    Dim strUser As String       'DSN user name
    Dim strPwd As String        'DSN user password
    Dim strData As String
    Dim i As Long
    Dim iMsgBoxResult As VbMsgBoxResult
    Dim colShipped As New Collection
    Dim rsOut As ADODB.Recordset
    
    Dim strQuery As String          'SQL query string
    Dim strService As String        'service code
    Dim strServiceId As String      'service id
    Dim strCountry As String        'country code
    Dim intDV As String             'Declared Value
    
    If Not Connect Then Exit Function   'set conection and recordset
    
    g_strErrorLocation = "Shipped"
    strData = GetDataShipped(strKey)
    If strData <> "" Then
        strData = strData & "Escape/Cancel to quit."
        iMsgBoxResult = MsgBox(strData, vbApplicationModal + vbOKCancel)
        If iMsgBoxResult = vbCancel Then
            frmShip.f1.Text = ""
            frmShip.f1.SetFocus
            Exit Function
        End If
    End If
    strData = ""
        
    If GetSystemName = "WINXPC9CA96EA3" Then
        strSQL = "select * from AddressBook"
        strSQL = strSQL & " Where "
        strSQL = strSQL & "CustID = '" & strKey & "'"
    Else
        strSQL = "SELECT hcust, hname, hatn, had1, had2, " & _
            "had3, hste, hpost, hcoun, chphon, hcarr, " & _
            "hsins FROM ECH WHERE hord = " & strKey
    End If
    
    DebugPrint strSQL
    
    m_RS.CursorLocation = adUseClient
    m_RS.Open strSQL, m_CNIn, adOpenStatic     'run SELECT

    If m_RS.BOF And m_RS.EOF Then
        'No records found for that order number
        Call MsgBox("Order " & strKey & " not found.", vbInformation + vbSystemModal, "Lookup Error!!!")
        m_RS.Close
        GetData = False
        Exit Function
    End If
    
    g_strKeyValue = Trim(UCase(strKey))
    
    Call DeleteIntlCommodities(strKey)

    strData = ""
    If m_RS.EOF Then
        strData = "No records"
    Else
        For i = 0 To m_RS.Fields.Count - 1
            strData = strData & vbCrLf & m_RS.Fields(i).name & " " & m_RS.Fields(i).Value
        Next i
    End If
    
    strData = "Record count " & m_RS.RecordCount & vbCrLf & strData
    
    If GetSystemName = "WINXPC9CA96EA3" Then
        Call GetDataToShipTest(strKey)
    Else
        Call GetDataToShip(strKey)
    End If
    
    ' Example use of the SetMessage sub
    ' Call SetMessage("Destination state is: " & m_RS!State, 16, vbBlack, True)

    frmShip.f1670.SetFocus
    
    GetData = True
Release:
    Exit Function
Handler:
    MsgBox Err.Description, , "modODBC.GetData"
    Call Kill
    Resume Release
    Resume

End Function
'


'---------------------------------------------------------------------------------------
' Procedure : GetDataCommit
' Purpose   : Test shipping confirmation tables for
'             previous shipments
'---------------------------------------------------------------------------------------
'
Private Sub GetDataCommit(ByVal strKey As String)
    On Local Error GoTo Handler

'    ' Declare variables for procedure
'    Dim objRecordset As ADODB.Recordset
'    Dim strSQL As String
'
'    If Not Connect Then Exit Sub   'set conection and recordset
'
'    strKey = QuoteTrim(strKey)
'
'    strSQL = ""
'    strSQL = "Select * From `COMMIT`"
'    strSQL = strSQL & " Where `POSTAL` = '" & strKey & "'"
'
'    Set objRecordset = New ADODB.Recordset
'    objRecordset.Open strSQL, m_CNCommit
'
'    ' ADODB doesn't give recordcount at first glance
'    ' If objRecordset.RecordCount > 0 Then
'    If Not objRecordset.BOF Then
'        MsgBox "This shipment may have a deferred delivery date.", _
'         vbInformation + vbApplicationModal + vbSystemModal, "Shipment delivery"
'         strKey = ""
'         m_booleanOnce = False
'         GoTo Release
'
'     ' ElseIf objRecordset.RecordCount = 0 Then  'Check for 4 character Postal code
'     Else
'        If m_booleanOnce = False Then
'            strKey = Left(strKey, 4)
'            m_booleanOnce = True    'Don't want it to loop all the time
'            Call GetDataCommit(strKey)
'        End If
'    End If
Release:
    Exit Sub
Handler:
    MsgBox Err.Description, , "modODBC.GetDataCommit"
    Call Kill
    Resume Release
    Resume

End Sub


'---------------------------------------------------------------------------------------
' Procedure : GetDataShipped()
' DateTime  : 7/5/2004
' Purpose   : Copernicus integration.  Test shipping confirmation tables for
'             previous shipments
' 2007-07-31, JFW, Per Rick Dingman, warn shipper of previous shipment on this order.
'---------------------------------------------------------------------------------------
'
Private Function GetDataShipped(ByVal strKey As String) As String
    On Local Error GoTo Handler
    Dim strSelect As String
    Dim strData As String
    Dim i As Long
    Dim iMsgBoxResult As VbMsgBoxResult
    Dim colShipped As New Collection
    Dim rsOut As ADODB.Recordset
    
    strData = ""
        
    If Not Connect Then Exit Function   'set conection and recordset
    
    GetDataShipped = strData
    
Release:
    Exit Function
Handler:
    MsgBox Err.Description, , "modODBC.GetDataShipped"
    Call Kill
    Resume Release
    Resume

End Function
'

'---------------------------------------------------------------------------------------
' Procedure : GetData()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Called from frmShip.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Sub GetDataToShip(strKey As String)

    On Local Error GoTo Handler

    Dim strWeight As String
    Dim strCountry As String
    Dim strPhone As String
    Dim strCity As String
    Dim strZip As String
    Dim strState As String
    Dim strRef As String
    Dim strInvoice As String
    Dim i As Long
        
    Dim strQuery As String          'SQL query string
    Dim strService As String        'service code
    Dim strServiceId As String      'service id
    Dim intDV As String             'Declared Value

    With frmShip
        
        'the following 2 lines are for country code conversion
        strCountry = Trim(m_RS.Fields("hcoun").Value)
        
        'call the country code conversion function
        '.Country = ModCountry.CountryConv(strCountry)
        .f50.Text = strCountry
        
        .f11.Text = Trim(m_RS.Fields("hname").Value)
        .f12.Text = Trim(m_RS.Fields("hatn").Value)
        
        'Enter ---- if there is no contact name
        If .f12.Text = "" Then
            .f12.Text = "----"
        End If
        
        'Fill in the 2 address lines
        .f13.Text = Trim(m_RS.Fields("had1").Value)
        .f14.Text = Trim(m_RS.Fields("had2").Value)
        
        'Enter ---- if there is no address 1
        If .f13.Text = "" Then
            .f13.Text = .f14.Text
        End If
            
        ' Fill in the City, State, Zip code and Phone
        .f15.Text = Trim(m_RS.Fields("had3").Value)
        .f16.Text = Trim(m_RS.Fields("hste").Value)
        .f17.Text = Trim(m_RS.Fields("hpost").Value)
        .f18.Text = Digit(Trim(m_RS.Fields("chphon").Value))
        
        ' If no phone number is retreived, fill in the default phone number
        If .f18.Text = "" Then
            If CUSTOMER_DEFAULT_PHONE <> "" Then
                .f18.Text = CUSTOMER_DEFAULT_PHONE
            Else
                .f18.Text = g_str183
            End If
        End If
        
        ' The next 3 lines are for the sercive convertion
'            strService = Trim(m_rs.Fields("hcarr").Value)
'            strServiceId = modServiceConvertion.ServiceTypeConvNameToId(strService)
'            .ServiceType = strServiceId
        
        '=============================================================
        ' Check for Saturday delivery
        
        Select Case strService
            Case "FDXP1S", "FDXECS"
                .f1266(0).Value = 1
            Case Else
                .f1266(0).Value = 0
        End Select
        .f1266(1).Value = .f1266(0).Value
        .f1266(2).Value = .f1266(0).Value
        
        '=============================================================
        'Checks to see if package is Insured, if it is sets the DV
        
        intDV = Trim(m_RS.Fields("hsins").Value) 'Declared Value
        
        If IsNumeric(intDV) Then
            If intDV >= 100 Then
                .f26.Text = intDV
            End If
        End If
        
        If frmSetup.chkScaleConnected = 1 Then
            .f1670 = ReadScale(Right(frmSetup.cmbScalePort, 1), Left(frmSetup.cboProtocol, 1))
        End If
        If Not IsNumeric(.f1670.Text) Then .f1670.Text = "1"
        If Val(.f1670.Text) <= 0 Then .f1670.Text = "1"
        
        .f75.Text = "lbs"
        .f1273.Text = "01"
        .f23.Text = "1"
        .f1274.Text = "92"
        
        'Order # will be placed in field id 25
        .f25.Text = g_strKeyValue
        
        .f1.Text = Trim(m_RS.Fields("hcust").Value)
        
        'This line of code forces the EditBoxLostFocus.
        ' Cafe1.Screen.SetCursor (116)
        
    End With
    
    g_strErrorLocation = "Done"

Release:
    Exit Sub
Handler:
    If Err.number = 13 Then
        Resume Next
    Else
        MsgBox Err.Description & " (ODBC1_SetPackageValues)", vbSystemModal
    End If
    
    MsgBox "Error at " & g_strErrorLocation & " - " & Err.Description, , "modODBC.GetDataToShip"
    Call Kill
    Resume Release
    Resume

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : GetData()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Called from frmShip.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Sub GetDataToShipTest(strKey As String)

    On Local Error GoTo Handler

    If LoadAddrFields("CustID", strKey, frmShip) Then
        frmShip.f25.SetFocus
    Else

    End If

    Call DeleteIntlCommodities(strKey)


Release:
    Exit Sub
Handler:
    If Err.number = 13 Then
        Resume Next
    Else
        MsgBox Err.Description & " (ODBC1_SetPackageValues)", vbSystemModal
    End If
    
    MsgBox "Error at " & g_strErrorLocation & " - " & Err.Description, , "modODBC.GetDataToShip"
    Call Kill
    Resume Release
    Resume

End Sub
'







'---------------------------------------------------------------------------------------
' Procedure : GetDataCommit
' Purpose   : Test shipping confirmation tables for
'             previous shipments
'---------------------------------------------------------------------------------------
'
Private Sub GetDataValidate(ByVal strRef As String)
    On Local Error GoTo Handler

    ' Declare variables for procedure
    Dim objRecordset As ADODB.Recordset
    Dim objRecordset2 As ADODB.Recordset
    Dim strSQL As String
    Dim strTrkNbr As String
    Dim strTranType As String
    Dim strDocNum As String
    
    If Not Connect Then Exit Sub   'set conection and recordset

    
Release:
    Exit Sub
Handler:
    MsgBox "Error at " & g_strErrorLocation & " - " & Err.Description, , "modODBC.GetDataToShip"
    Call Kill
    Resume Release
    Resume

End Sub




'---------------------------------------------------------------------------------------
' Procedure : GetPickupData()
' DateTime  : 1/30/2006
' Purpose   : REQUIRED SUB. Called from frmAddTags.f1_LostFocus, which is the OrderID field.
'             Call routines needed to get data from the customer's system and assign the
'             value to the appropriate fields on the Ship form. This example uses ODBC.
'---------------------------------------------------------------------------------------
'
Public Function GetPickupData(ByVal strKey As String) As Boolean

    GetPickupData = True

End Function
'

Function ServiceConvBack(ByRef ServiceBack As String)
 
    'Written by Bruce Acomb on 7/7/3.
    'Called from ODBC2.WriteBack.
    'This function converts the CAFE service code
    'to a customer-friendly service code.
    
    On Error GoTo EH
    
    Select Case UCase(ServiceBack)
        Case "1"           'Express
             ServiceConvBack = "EXP"
        Case "3"            'ECONOMY
             ServiceConvBack = "ECO"
        Case "6"            'First Overnight
             ServiceConvBack = "F-1"
        Case "92"           'Ground
             ServiceConvBack = "GRD"
        Case "90"           'Home Delivery Ground
             ServiceConvBack = "GRH"
        Case Else           'Default
             ServiceConvBack = "FDX"

    End Select
    
    Exit Function
EH:
   MsgBox Err.Description, vbSystemModal, "ODBC2.ServiceConvBack"
End Function



Function ServiceConvFunc(ByRef ServiceConv As String)
 
    'This function converts the CAFE service code
    'to a customer-friendly service code.
    
    On Error GoTo EH
    
    Select Case UCase(ServiceConv)
        Case "1"           'Express
             ServiceConv = "EXP"
        Case "3"            'ECONOMY
             ServiceConv = "ECO"
        Case "6"            'First Overnight
             ServiceConv = "F-1"
        Case "92"           'Ground
             ServiceConv = "GRD"
        Case "90"           'Home Delivery Ground
             ServiceConv = "GRH"
        Case Else           'Default
             ServiceConv = "EXP"
    End Select
    
    Exit Function
EH:
   MsgBox Err.Description, vbSystemModal, "ODBC1.ServiceConv"
End Function

'---------------------------------------------------------------------------------------
' Procedure : WriteBatchEditReply()
' DateTime  : 1/17/2006
' Purpose   : REQUIRED SUB. Called after a successful Batch Error Edit transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteBatchEditReply()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteBOLReply()
' DateTime  : 1/11/2006
' Purpose   : REQUIRED SUB. Called after a successful FedEx Freight BOL transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteBOLReply()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteCancelTagReply()
' DateTime  : 1/26/2006
' Purpose   : REQUIRED SUB. Called after a successful Cancel Call Tag/Express Tag transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteCancelTagReply()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteReply()
' DateTime  : 2/14/2005
' Purpose   : REQUIRED SUB. Called after a successful ship transaction.
'             This example shows how to obtain multiple occurrence fields from the
'             FXRS reply and how to obtain multiple occurrence fields included in the
'             input transaction but not returned in the FXRS reply.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReply()
    
    On Local Error GoTo Handler
    
    ' Declare variables for procedure
    Dim strSQL As String
    
    Dim i As Integer
    Dim j As Integer
    
    Dim f1 As String                    'OrderID (in TransID field)
    Dim f34 As String                   'Base charge
    Dim f35 As String                   'Total surcharges
    Dim f36 As String                   'Total discount
    Dim f37 As String                   'Net charge
    Dim f60 As String                   'Billed weight
    Dim f116 As String                  'Num pkgs
    Dim f1393 As String                 'Total fuel
    Dim f1528 As String                 'Net List charge
    Dim f1597 As String                 'List handling
    Dim f2009 As String                 'Total customer charge
    Dim strInsert As String             'SQL INSERT
    Dim strMPS As String                'MPS SELECT query
    Dim rsMPS As New ADODB.Recordset    'Used to capture MPS input fields
    
    'Declare string arrays for trk#s and declared values
    Dim str29() As String
    Dim str26() As String
    Dim str1670() As String
    Dim str60() As String
    Dim str25() As String
    
    Dim intNumPkgs As Integer

    ' Declare variables for sql statement
    Dim strWriteback As String
    Dim strTrackNO As String
    Dim strRef As String
    Dim strNetCharge As String
    Dim strGST As String
    Dim strPST As String
    Dim strHST As String
    Dim strCount As String
    Dim strWeight As String
    Dim strChrBeforeTax As String
    Dim strCurrentDate As String
    Dim strValid As String
    Dim strFedEx As String
    Dim strShipID As String
    Dim strTrackDefaultNO As String
    Dim vbResultWed As VbMsgBoxResult
    
    Dim dblNetCharge As Double
    Dim dblGST As Double
    Dim dblPST As Double
    Dim dblHST As Double
    Dim dblChargeBeforeTax As Double

    Dim strDocNumber As String
    Dim strTranType As String
    
    Dim strCustomerID As String         'Customer ID
    Dim strReference As String          'order#
    Dim strShipMethod As String         'shipping method
    Dim strShipMethodName As String     'Service type name
    Dim strCompany As String            'Company
    Dim strContact As String            'Contact
    Dim strAdd1 As String               'Address 1
    Dim strAdd2 As String               'Address 2
    Dim strCity As String               'City
    Dim strState As String              'State
    Dim strZip As String                'Zip
    Dim strCharge As String             'charge
    Dim strPaytype As String            'Payment type
    Dim strTotalPkgs As String          'Total number of packages
    Dim strCustomerCost As String       ' Total customer cost (inc. handling charges)
    Dim strBilledWeight As String             'Billed Weight
    Dim strCty As String                'Country
    
    g_strErrorLocation = "Connect"
    
    ' Validate Connection object
    If Not Connect Then Exit Sub
        
    'Get # of pkgs
    g_strErrorLocation = "116"
    intNumPkgs = Val(g_str116)
    
    'ReDim the string array using the # of pkgs
    ReDim str29(intNumPkgs)
    ReDim str26(intNumPkgs)
    ReDim str1670(intNumPkgs)
    ReDim str60(intNumPkgs)
    ReDim str25(intNumPkgs)
    
    'Get the fields you wish from the reply transaction
    g_strErrorLocation = "Parser"
    With frmShip.g_clsParser
        For i = 0 To .TotalFields - 1
            Select Case .Field(i)
                Case "1"
                    f1 = .Data(i)           'TransID
                Case "29"
                    str29(0) = .Data(i)     'First trk#
                Case "34"
                    f34 = .Data(i)          'Base charge
                Case "35"
                    f35 = .Data(i)          'Total Surcharges
                Case "36"
                    f36 = .Data(i)          'Total Discount
                Case "37"
                    f37 = .Data(i)          'Net Charges
                Case "60"
                    f60 = .Data(i)          'Billed Weight
                    str60(0) = .Data(i)
                Case "116"
                    f116 = .Data(i)         '# Pkgs
                Case "1393"
                    f1393 = .Data(i)        'Fuel
                Case "1528"
                    f1528 = .Data(i)        'List charge
                Case "1597"
                    f1597 = .Data(i)        'List handling
                Case "2009"
                    f2009 = .Data(i)        'Total customer charge
            End Select
        
            'Get multiple occurrence tracking #s
            'Note: This will capture Int'l MPS child trk#s as well as domestic MPS
            If intNumPkgs > 1 And frmShip.chkDuplicate = 0 Then
                For j = 2 To intNumPkgs
                    If .Field(i) = "29-" & Trim(Str(j)) Then
                        str29(j - 1) = .Data(i)
                    End If
                    If .Field(i) = "60-" & Trim(Str(j)) Then
                        str60(j - 1) = .Data(i)
                    End If
                Next
            End If
        Next
    End With
    
    g_strErrorLocation = "MPS"
    'Query to get fields saved in MPS table for MPS transactions
    ' 2006-11-07, JFW, Add order to MPS select to preserve package order
    strMPS = "SELECT * FROM MPS WHERE f1 = '" & f1 & "' order by ShipDate"
    DebugPrint "FSMSClient, StaticControl, WriteReply, MPS query (" & strWriteback & ")"
    
    'Open recordset
    rsMPS.Open strMPS, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
    
    strWeight = 0
    
    'Loop through the MPS recordset and assign the Declared Value fields
    'Note: You can also capture any other MPS field using this loop by declaring
    'variables for those data element assigning the values here.
    g_strErrorLocation = "DV"
    i = 0
    If Not rsMPS.EOF Then
        Do Until rsMPS.EOF
            str26(i) = rsMPS!g_str26 & ""
            str1670(i) = rsMPS!g_str1670
            str25(i) = rsMPS!g_str25
            strWeight = CDec(strWeight) + CDec(IIf(IsNumeric(rsMPS!g_str1670 & ""), rsMPS!g_str1670 & "", 1))
            rsMPS.MoveNext
            i = i + 1
        Loop
    Else
        str25(0) = g_str25
        str26(0) = g_str26
        str1670(0) = g_str1670
        strWeight = CDec(IIf(IsNumeric(g_str1670 & ""), g_str1670 & "", 1))
    End If
    
    strNetCharge = 0
    
    'Perform Insert query for each package
    g_strErrorLocation = "NumPkgs"
    For i = 0 To UBound(str29)
        
        If str29(i) <> "" Then
        
            ' Set return values
            strRef = str25(i)
            dblNetCharge = IIf(IsNumeric(g_str37), g_str37, 0) / 100
            strNetCharge = CDec(strNetCharge) + CDec(dblNetCharge)
            dblGST = 0
            dblPST = 0
            dblHST = 0
            strCount = IIf(IsNumeric(g_str116), Val(g_str116), 1)
            strShipID = ""
            ' strInvoiceSDN = g_str3057
                
            If i = 0 Then
                dblChargeBeforeTax = IIf(IsNumeric(f34), Val(f34), 0) - IIf(IsNumeric(f36), Val(f36), 0) + IIf(IsNumeric(f1393), Val(f1393), 0)
                strChrBeforeTax = CStr(dblChargeBeforeTax / 100)
                'strCharge will be formatted from 3550 to 35.50 format
                strCharge = f37
                ' strCustomerCost = f2009 ' Net plus handling
                strCustomerCost = f37 ' f2009
                ' Total customer charge
                If IsNumeric(f1528) Then
                    If Val(f1528) > 0 Then
                        strCustomerCost = f1528
                    End If
                End If
            Else
                dblChargeBeforeTax = 0
                strChrBeforeTax = 0
                'strCharge will be formatted from 3550 to 35.50 format
                strCharge = 0
                ' Total customer charge
                strCustomerCost = 0
            End If
            strCurrentDate = "Shipped " & Format(Now, "MM/DD/YY hh:mm")
            strValid = "Y"
            strFedEx = "FedEx"
            strTrackDefaultNO = "1"
        
            strTrackNO = str29(i)
            strWeight = str1670(i)
            strBilledWeight = str60(i)
            
            strCustomerID = g_str1
            strReference = str25(i)
            strShipMethod = g_str1274
            strCompany = Replace(g_str12, "'", "''", , , vbTextCompare)
            strCompany = Replace(strCompany, "/", "-", , , vbTextCompare)
            strContact = Replace(g_str11, "'", "''", , , vbTextCompare)
            strAdd1 = Replace(g_str13, "'", "''", , , vbTextCompare)
            strAdd2 = Replace(g_str14, "'", "''", , , vbTextCompare)
            strCity = Replace(g_str15, "'", "''", , , vbTextCompare)
            
            strState = g_str16
            strZip = g_str17
            strCty = g_str50
                        
            strPaytype = g_str23
            strTotalPkgs = g_str116
            
            ' Service Code convertion to a Name
            strShipMethodName = ServiceTypeConvIdToName(strShipMethod)
            If IsNumeric(strCharge) Then
                strCharge = Round(Val(strCharge) / 100, 2)
            Else
                strCharge = 0
            End If
            If IsNumeric(strCustomerCost) Then
                strCustomerCost = Round(Val(strCustomerCost) / 100, 2)
            Else
                strCustomerCost = 0
            End If
                
            'Store Procedure on Static's SQL Server.
            strSQL = "CP_FDX_CA '" & strReference & "', '" & strCustomerID & "', "
            strSQL = strSQL & "'FEDEX', '" & strShipMethodName & "', '" & strCompany & "', "
            strSQL = strSQL & "'" & strContact & "', '" & strAdd1 & "', '" & strAdd2 & "', "
            strSQL = strSQL & "'" & strCity & "', '" & strState & "', '" & strCty & "', '" & strZip & "', "
            strSQL = strSQL & "'N', '" & strTrackNO & "', '" & strWeight & "', '" & strBilledWeight & "', "
            strSQL = strSQL & "'" & strCharge & "', '" & strPaytype & "', '" & strTotalPkgs & "' "
            strSQL = strSQL & ",'" & strCustomerCost & "'"
            
            g_strErrorLocation = "SQL insert"
            DebugPrint strSQL
            
            If GetSystemName = "WINXPC9CA96EA3" Then
                MsgBox strSQL
            Else
                Call m_CNOut.Execute(strSQL)
            End If
            
        End If ' str29
        
    Next i
    
    m_strInvoiceSDN = ""
    g_strRefNo = ""
    g_strErrorLocation = "Done"
    
Release:
    g_str4 = m_strShipperCompany
    DebugPrint "ClearShipScreen, company now " & g_str4
    ' call kill
    If rsMPS.State = adStateOpen Then rsMPS.Close
    Set rsMPS = Nothing
    Exit Sub

Handler:
    DebugPrint "FSMSClient, StaticControl, WriteReply, Error at " & g_strErrorLocation & " - " & Err.Description
    MsgBox "Error at " & g_strErrorLocation & " - " & Err.Description, , "modODBC.WriteReply"
    Call Kill
    Resume Release
    Resume
    
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteError()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             an FXRS Error reply transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteError()
    DebugPrint "FSMSClient, StaticControl, WriteError, tag 3 (" & g_str3 & ")"
    MsgBox "Shipping Error: " & g_str3, vbCritical, "FSMS Error"
End Sub
'

'---------------------------------------------------------------------------------------
' Procedure : WriteDelete()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed after
'             successful FXRS Delete.
'---------------------------------------------------------------------------------------
'
Public Sub WriteDelete(ByVal strTracking As String)
'Called:    frmShip Parsecomplete event on FSMS 123 reply
'Purpose:   update customer table on void
    On Local Error GoTo Handler
    
    ' Declare variables for procedure
    Dim strSQL As String
    ' Declare variables for procedure
    Dim strWriteback  As String
    Dim lngErr As Long
    Dim strIndexVal As String
    Dim strDate As String
    Dim lngExecute As Long
    
    Dim strCustomerID As String         'Customer id # field id 2070
    Dim strTrackNO As String            'tracking number
    Dim strReference As String          'order#
    Dim strShipMethod As String         'shipping method
    Dim strShipMethodName As String     'Service type name
    Dim strCompany As String            'Company
    Dim strContact As String            'Contact
    Dim strAdd1 As String               'Address 1
    Dim strAdd2 As String               'Address 2
    Dim strCity As String               'City
    Dim strState As String              'State
    Dim strZip As String                'Zip
    Dim strCharge As String             'charge
    Dim strWeight As String             'weight
    Dim strPaytype As String            'Payment type
    Dim strTotalPkgs As String          'Total number of packages
    Dim strCustomerCost As String       ' Total customer cost (inc. handling charges
    Dim strBilledWeight As String       'Billed Weight
    Dim strCty As String
    
    ' Validate Connection state
    If Not Connect Then Exit Sub

    ' Validate * is compliant with inline error handling
    On Error Resume Next
    
    strDate = Format(Now, "MM/DD/YY hh:mm")
 
    ' Validate Connection object
    If Not Connect Then Exit Sub
 
'    g_strErrorLocation = "Shipment"
'    strMPS = "SELECT * FROM Shipment WHERE g_str29 = '" & strTracking & "' order by g_str29"
'
'    'Open recordset
'    rsMPS.Open strMPS, g_connFSMSClient, adOpenStatic, adLockBatchOptimistic
    




    
    strTrackNO = strTracking
    
'    strCustomerID = tblReturn.Records(0).Fields(0).Value
'    strReference = tblReturn.Records(0).Fields(1).Value
'    strShipMethod = tblReturn.Records(0).Fields(2).Value
'    strCompany = Replace(tblReturn.Records(0).Fields(3).Value, "'", "''", , , vbTextCompare)
'    strContact = Replace(tblReturn.Records(0).Fields(4).Value, "'", "''", , , vbTextCompare)
'    strAdd1 = Replace(tblReturn.Records(0).Fields(5).Value, "'", "''", , , vbTextCompare)
'    strAdd2 = Replace(tblReturn.Records(0).Fields(6).Value, "'", "''", , , vbTextCompare)
'    strCity = Replace(tblReturn.Records(0).Fields(7).Value, "'", "''", , , vbTextCompare)
'    strState = tblReturn.Records(0).Fields(8).Value
'    strZip = tblReturn.Records(0).Fields(9).Value
'    strWeight = tblReturn.Records(0).Fields(10).Value
'    strBilledWeight = tblReturn.Records(0).Fields(15).Value
'    strCty = tblReturn.Records(0).Fields(16).Value
    
    'strCharge will be formatted from 3550 to 35.50 format
    strCharge = 0
    strCustomerCost = 0
    
    ' Total customer charge
    strCustomerCost = 0
    
    strPaytype = 1
    strTotalPkgs = 1
    
    ' Service Code convertion to a Name
    strShipMethodName = ServiceTypeConvIdToName("92")
           
    'Store Procedure on Static's SQL Server.
    strSQL = "CP_FDX_CA '" & strReference & "', '" & strCustomerID & "', "
    strSQL = strSQL & "'FEDEX', '" & strShipMethodName & "', '" & strCompany & "', "
    strSQL = strSQL & "'" & strContact & "', '" & strAdd1 & "', '" & strAdd2 & "', "
    strSQL = strSQL & "'" & strCity & "', '" & strState & "', '" & strCty & "', '" & strZip & "', "
    strSQL = strSQL & "'Y', '" & strTrackNO & "', '" & strWeight & "', '" & strBilledWeight & "', "
    strSQL = strSQL & "'" & strCharge & "', '" & strPaytype & "', '" & strTotalPkgs & "' "
    strSQL = strSQL & ",'" & strCustomerCost & "'"
    
    DebugPrint strSQL
    
    'Execute SQL statement
    If GetSystemName = "WINXPC9CA96EA3" Then
        MsgBox strSQL
    Else
        lngExecute = 0
        Call m_CNOut.Execute(strSQL, lngExecute)
        If lngExecute > 0 Then
            DebugPrint "FSMSClient, StaticControl, WriteDelete, records (" & lngExecute & "), SQL (" & strWriteback & ")"
        End If
    End If
    
Release:
   ' call kill
   Exit Sub
Handler:
    MsgBox Err.Description, , "modODBC.WriteDelete"
    Call Kill
    Resume Release
    
End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteReturnDelete()
' DateTime  : 7/14/2005
' Purpose   : REQUIRED SUB. Called after a successful return label delete transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReturnDelete(ByVal strTracking As String)

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteReturnReply()
' DateTime  : 7/14/2005
' Purpose   : REQUIRED SUB. Called after a successful return label transaction.
'             This is called for both regular and online return labels.
'---------------------------------------------------------------------------------------
'
Public Sub WriteReturnReply()

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : WriteTagReply()
' DateTime  : 1/26/2006
' Purpose   : REQUIRED SUB. Called after a successful Call Tag/Express Tag transaction.
'---------------------------------------------------------------------------------------
'
Public Sub WriteTagReply()

End Sub
'



'---------------------------------------------------------------------------------------
' Procedure : Initialize()
' DateTime  : 7/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed on
'             program execution.
'---------------------------------------------------------------------------------------
'
Public Sub Initialize(Optional f1 As Form)

    If Not f1 Is Nothing Then
        If f1.name = "frmShip" Then
'            frmShip.f38 = g_clsReg.GetRegistryValue("Carry_f38", "")
'            frmShip.f1273.Text = g_clsReg.GetRegistryValue("Carry_f1273", "")
        End If
        If f1.name = "frmDGDisclaimer" Then
        
        End If
    End If
    
End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : BeforeBatchShip()
' DateTime  : 8/5/2004
' Purpose   : REQUIRED SUB. Can be used as hook to call routines to be executed on
'             program execution. Called just before a batch transaction is sent to the server.
'---------------------------------------------------------------------------------------
'
Public Function BeforeBatchShip() As Boolean

    BeforeBatchShip = True
    
End Function
'





Public Function ServiceTypeConvNameToId(ServiceName As String) As String
    'Written by Bruce Acomb on 7/7/3.
    ' Modified by Chris Barger on 2/10/05.
    'Called from ODBC1.QueryTable.
    'This function converts the customer service type
    'to a CAFE-friendly service code.
    
    On Error GoTo ERROR_HANDLER
    
    Select Case UCase(ServiceName)
        Case "FXFRST"                       ' First Overnight
            ServiceTypeConvNameToId = "6"
        
        Case "FEDXP1"                       ' Priority Overnight
            ServiceTypeConvNameToId = "1"
        
        Case "FEDXS"                        ' Standard Overnight
            ServiceTypeConvNameToId = "5"
        
        Case "FDXECO"                       ' 2nd Day
            ServiceTypeConvNameToId = "3"
        
        Case "FDXEXS"                       ' Express Saver
            ServiceTypeConvNameToId = "20"
        
        '=============================================================================
        
        Case "FEDXGR"                       ' Ground
            ServiceTypeConvNameToId = "92"
        
        Case "????"                         ' Home Delivery
            ServiceTypeConvNameToId = "90"
        
        '=============================================================================
        
        Case "FXIP1"                        ' Internaional Priority
            ServiceTypeConvNameToId = "101"
        
        Case "FDXINT"                       ' International Economy
            ServiceTypeConvNameToId = "103"
        
        '=============================================================================
        
        Case "FDXP1F", "FXIP1F"             ' 1-day Freight / Intl. Priority Freight
            ServiceTypeConvNameToId = "70"
            
        Case "2-day Freight"                ' 2-day Freight
            ServiceTypeConvNameToId = "80"
            
        Case "3-day Freight"                ' 3-day Freight
            ServiceTypeConvNameToId = "83"
            
        Case "Intl. Economy Freight"        ' Intl. Economy Freight
            ServiceTypeConvNameToId = "86"
            
        '=============================================================================
        '=============================================================================
        
        Case Else               'Default to Standard Overnight
            ServiceTypeConvNameToId = "5"
    End Select
    
    Exit Function
ERROR_HANDLER:
   Call MsgBox(Err.Description, vbSystemModal + vbCritical, "modServiceConvertion.ServiceTypeConvNameToId")
End Function

Public Function ServiceTypeConvIdToName(ServiceCode As String, Optional Country As String = "CA") As String
    'Written by Bruce Acomb on 7/7/3.
    ' Modified by Chris Barger on 2/7/2005
    'Called from ODBC1.WriteBack.
    'This function converts the CAFE service code
    'to a customer-friendly service code.
    
    On Error GoTo ERROR_HANDLER
    
    Select Case UCase(ServiceCode)
        Case "1", "01"
            If Country = "CA" Then      'domestic
                ServiceTypeConvIdToName = "PRIORITY" 'Priority Overnight
            Else                        'international
                ServiceTypeConvIdToName = "INT PRIORITY" 'International Priority
            End If
        
        Case "5", "05"
            If Country = "CA" Then      'domestic
                ServiceTypeConvIdToName = "STANDARD" 'Standard Overnight
            Else                        'international
                ServiceTypeConvIdToName = "INT ECONOMY" 'International Economy
            End If
        
        Case "3", "03"                        '2nd Day
            ServiceTypeConvIdToName = "2 DAY"
        
        Case "20"                       'Express Saver
            ServiceTypeConvIdToName = "ECONOMY"
        
        Case "6", "06"                        'First Overnight
            ServiceTypeConvIdToName = "FIRST"
        
        Case "92"                   'Ground
            ServiceTypeConvIdToName = "GROUND"
        
        Case "90"                   'Home Delivery
            ServiceTypeConvIdToName = "HOME DELIVERY"
            
        Case "70"                   '1DAY FREIGH
            ServiceTypeConvIdToName = "1DAY FREIGHT"
            
        Case "80"                   '2DAY FREIGHT
            ServiceTypeConvIdToName = "2DAY FREIGHT"
            
        Case "83"                   '3DAY FREIGH
            ServiceTypeConvIdToName = "3DAY FREIGHT"
            
        Case "86"                   'Intl. Economy Freight
            ServiceTypeConvIdToName = "Intl. Economy Freight"
        
        Case Else                   'Default
            ServiceTypeConvIdToName = "UNKNOWN"
    End Select
    
   '==========service code back conversion function======================
'        If strShipMethod = "92" Then
'            strShipMethod = "FedEx Ground"
'        Else
'            strShipMethod = "FedEx Express"
'        End If
    '====================================================================
    
    Exit Function
ERROR_HANDLER:
   Call MsgBox(Err.Description, vbSystemModal + vbCritical, "modServiceConvertion.ServiceTypeConvIdToName")
End Function







#End If






